home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d26 / cattest.arc / CHECKANS.PAS < prev    next >
Pascal/Delphi Source File  |  1991-07-01  |  6KB  |  199 lines

  1. unit checkans;
  2. {$UNDEF debug }
  3.   (* remarks - October 5, 1990; added functions with open bracket
  4.                                 search
  5.                                 *)
  6. interface
  7. uses Crt,Utility,Eval3;
  8.  
  9. VAR
  10.   MyErrTyp,MyErrPos  : Integer;
  11.   MyErrMsg : STRING;
  12.   uc_var : char;
  13. FUNCTION Check_Answer(s1,s2:STRING;tolerance:real): BOOLEAN;
  14. implementation
  15.  
  16.  
  17. FUNCTION Check_Answer(s1,s2:STRING;tolerance:real): BOOLEAN;
  18.  
  19. VAR
  20.   rno : REAL;
  21.   arno : STRING[8];
  22.   k,k1,l : INTEGER;
  23.   const_val : ARRAY[1..26] OF STRING;
  24.  
  25. PROCEDURE EXCISE(VAR s:STRING;arno:STRING);
  26.  
  27. LABEL exit_this_loop;
  28.  
  29. CONST
  30.   builtinNames : ARRAY [1..19] OF STRING
  31.                  = ('abs(', 'round(', 'trunc(', 'sqrt(', 'sqr(',
  32.                     'arcsin(', 'arccos(', 'arctan(', 'sinh(', 'cosh(', 'tanh(',
  33.                     'sin(', 'cos(', 'tan(',
  34.                     'ln(', 'log(', 'log2(', 'exp(', 'fact(');
  35.  
  36. VAR
  37.   s2,s_mask  : STRING;
  38.   k_pos,
  39.   k,k_loc,k_len,count : integer;
  40.  
  41. procedure mask_string;
  42.   var k : integer;
  43. CONST
  44.   Numbers : set of char = ['0'..'9','.'];
  45. begin
  46.   s_mask := '';
  47.   if s[1] in Numbers then s := '(' + s  + ')';
  48.   if s[length(s)] in Numbers then s:= '(' + s + ')';
  49.   FOR k := 1 to Length(s) do (* mask off interface between numbers
  50.                                and other characters *)
  51.      if s[k] in ['0'..'9','.'] then s_mask := s_mask + '0' else
  52.        s_mask := s_mask + '1';
  53. end;
  54. BEGIN (*1*)
  55.   (*first enclose numbers in parenthesis*)
  56.   mask_string;
  57.   k := pos('01',s_mask);
  58.   while k > 0 do
  59.     begin
  60.       insert(')',s,k+1);
  61.       insert(')',s_mask,k+1);
  62.       k := pos('01',s_mask);
  63.     end;
  64.  
  65.   k := pos('10',s_mask);
  66.   while k > 0 do
  67.     begin
  68.       insert('(',s,k+1);
  69.       insert('(',s_mask,k+1);
  70.       k := pos('10',s_mask);
  71.     end;
  72.  
  73.   FOR k := 1 TO 19 DO
  74.     BEGIN(*2*)
  75.       k_loc := pos(builtinNames[k],s);
  76.       WHILE k_loc > 0 DO
  77.         BEGIN (*3*)
  78.           FOR k_len := 0 TO Length(builtinNames[k] )-2 DO
  79.             s[k_len+k_loc] := chr(ord(s[k_len+k_loc]) OR $80) ;
  80.           insert('(',s,k_loc); {enclose function in brackets}
  81.           count := 0;
  82.           FOR k_len := k_loc+Length(builtinNames[k]) TO Length(s) DO
  83.             BEGIN (*4*)
  84.               IF s[k_len] = '('
  85.                 THEN inc(count);
  86.               IF s[k_len] = ')'
  87.                 THEN dec(count);
  88.               IF count = 0
  89.                 THEN
  90.                   BEGIN (*5*)
  91.                     insert(')',s,k_len+1);
  92.                     GOTO exit_this_loop;
  93.                   END;(*5*)
  94.             END; (*4*)
  95.           exit_this_loop:
  96.                           k_loc := pos(builtinNames[k],s);
  97.          END; (*3*)
  98.       END; (*2*)
  99.  
  100. {once all functions are 8-bit highed, uppercase for constants}
  101.   FOR  k := 1 TO length(s) DO
  102.     s[k] := UpCase(s[k]);
  103.  
  104.      repeat
  105.        l := LENGTH(s);
  106.        k := POS(uc_var,s);
  107.        s2 := COPY(s,1,k-1)+'('+arno+')'+COPY(s,k+1,l-k); { if variable
  108.                                                            present, then
  109.                                                            replace with random
  110.                                                            number surrounded
  111.                                                            in brackets }
  112.        s := s2;
  113.        k := POS(uc_var,s);
  114.      UNTIL k = 0; {continue until variable gone}
  115.  
  116. {now eliminate all constants 'A' .. 'Z', assuming one letter, except
  117.  for the variable itself}
  118.   FOR k := 1 TO 26 DO
  119.     BEGIN
  120.       k_loc := pos(CHR(k+64),s);
  121.       WHILE k_loc <> 0 DO
  122.         BEGIN
  123.           s := COPY(s,1,k_loc-1)+'('+const_val[k]+')'+COPY(s,k_loc+1,length(s));
  124.           k_loc := pos(CHR(k+64),s);
  125.         END;
  126.     END;
  127.  
  128. (*     REPEAT
  129.        s2 := '';
  130.        IF (s[k-1] IN ['0'..'9','.']) AND (k>1)
  131.          THEN insert('*',s,k); {example 7X -> 7*X}
  132.  
  133.        IF (s[k+1] IN ['0'..'9','.']) AND (k+1<=l)
  134.          THEN insert('*',s,k+1); {example X9 -> X*9}
  135.   *)
  136.   FOR k_len := 1 TO length(s) DO
  137.      s[k_len] := chr(ord(s[k_len]) AND $7F) ; {restore builtin functions}
  138.  
  139.   k_pos := POS(')(',s);
  140.   WHILE k_pos > 0 DO
  141.     BEGIN
  142.       insert('*',s,k_pos+1);
  143.       k_pos := POS(')(',s);
  144.     END;
  145.  
  146.   k_pos := POS('()',s);
  147.   WHILE k_pos > 0 DO
  148.     BEGIN
  149.       DELETE (s,k_pos,2);
  150.       k_pos := POS('()',s);
  151.     END;
  152.  
  153. END;
  154.  
  155. VAR
  156.   Value1,Value2 : REAL;
  157.  
  158.    BEGIN
  159.      FOR k := 1 TO 26 DO
  160.        STR(RANDOM:8:7,const_val[k]); (*initialize
  161.                                                       constant's
  162.                                                       substitution list*)
  163.      Check_Answer := FALSE;
  164.      k := POS(uc_var,s1);
  165.      rno := RANDOM;
  166.      STR(rno:8:7,arno);(*initialize variable's substitution*)
  167.      EXCISE(s1,arno);
  168.      Value1 := RANDOM;
  169.      Evaluate(s1,Value1,MyErrPos,MyErrMsg);
  170.      {$IFDEF debug}
  171.        GoToXY(1,15);
  172.        WriteLn('s1 = ',s1);
  173.        WriteLn('Value1 = ',Value1);
  174.        Pause(1,25,'Press any key to continue.');
  175.      {$ENDIF}
  176.      IF MyErrPos <> 0
  177.        THEN
  178.          exit
  179.          ELSE
  180.            BEGIN
  181.              EXCISE(s2,arno);
  182.              Value2 := RANDOM;
  183.              Evaluate(s2,Value2,MyErrPos,MyErrMsg);
  184.              IF MyErrPos <> 0
  185.                THEN
  186.                  exit;
  187.              {$IFDEF debug}
  188.               GoToXY(1,17);
  189.               WriteLn('s2 = ',s2);
  190.               WriteLn('Value2 = ',Value2);
  191.               Pause(1,25,'Press any key to continue.');
  192.               {$ENDIF}
  193.              IF abs(Value1-Value2) <= tolerance
  194.                THEN Check_Answer := TRUE;
  195.  
  196.            END;
  197. END;  {end Check_Answer}
  198. END.
  199.